Celestin Apprentice 4/Apprentice-Release4.iso/Source Code/By the Book/Mac Pascal Primer, 4.0/Chap 6, Reminder ƒ/Reminder.p

Text File | 1991-08-23 | 13.5 KB | 548 lines | [TEXT/PJMM]

program Reminder;
    uses
        Notification;

    const
        BASE_RES_ID = 400;
        ABOUT_ALERT = 401;
        BAD_SYS_ALERT = 402;

        MIN_SLEEP = 0;

        DRAG_THRESHOLD = 30;

        SAVE_BUTTON = 1;
        CANCEL_BUTTON = 2;
        TIME_FIELD = 4;
        S_OR_M_FIELD = 5;
        SOUND_ON_BOX = 6;
        ICON_ON_BOX = 7;
        ALERT_ON_BOX = 8;
        SECS_RADIO = 10;
        MINS_RADIO = 11;

        DEFAULT_SECS_ID = 401;
        DEFAULT_MINS_ID = 402;

        ON = 1;
        OFF = 0;

        SECONDS_PER_MINUTE = 60;

        TOP = 25;
        LEFT = 12;

        MARK_APPLICATION = 1;

        APPLE_MENU_ID = BASE_RES_ID;
        FILE_MENU_ID = BASE_RES_ID + 1;
        ABOUT_ITEM = 1;

        CHANGE_ITEM = 1;
        START_STOP_ITEM = 2;
        KILL_ITEM = 3;
        QUIT_ITEM = 4;

        SYS_VERSION = 2;

    type
        settings = record
                timeString: Str255;
                sound, icon, alert, secsRadio, minsRadio: INTEGER;
            end;

    var
        gSettingsDialog: DialogPtr;
        gDragRect: Rect;
        gDone, gCounting, gNotify_set: BOOLEAN;
        gSeconds_or_minutes: (seconds, minutes);
        gNotifyStrH, gDefaultSecsH, gDefaultMinsH: StringHandle;
        gMyNMRec: NMRec;
        gAppleMenu, gFileMenu: MenuHandle;
        gTheEvent: EventRecord;
        savedSettings: settings;


    procedure HandleEvent;
    forward;


{-------------------------------->    SetNotification    <---}

    procedure SetNotification;
        var
            itemType: INTEGER;
            itemRect: Rect;
            itemHandle: Handle;
            dummy: OSErr;
    begin
        if gNotify_set then
            begin
                dummy := NMRemove(@gMyNMRec);
                HUnlock(Handle(gNotifyStrH));
            end;

        GetDItem(gSettingsDialog, ICON_ON_BOX, itemType, itemHandle, itemRect);
        if GetCtlValue(ControlHandle(itemHandle)) = ON then
            gMyNMRec.nmIcon := GetResource('SICN', BASE_RES_ID)
        else
            gMyNMRec.nmIcon := nil;

        GetDItem(gSettingsDialog, SOUND_ON_BOX, itemType, itemHandle, itemRect);
        if GetCtlValue(ControlHandle(itemHandle)) = ON then
            gMyNMRec.nmSound := GetResource('snd ', BASE_RES_ID)
        else
            gMyNMRec.nmSound := nil;

        GetDItem(gSettingsDialog, ALERT_ON_BOX, itemType, itemHandle, itemRect);
        if GetCtlValue(ControlHandle(itemHandle)) = ON then
            begin
                MoveHHi(Handle(gNotifyStrH));
                HLock(Handle(gNotifyStrH));
                gMyNMRec.nmStr := gNotifyStrH^;
            end
        else
            gMyNMRec.nmStr := nil;

        dummy := NMInstall(@gMyNMRec);
        EnableItem(gFileMenu, KILL_ITEM);
        gNotify_set := TRUE;
    end;


{-------------------------------->    CountDown    <---}

    procedure CountDown (numSecs: LONGINT);
        var
            myTime, oldTime, difTime: LONGINT;
            myTimeString: Str255;
            countDownWindow: WindowPtr;
    begin
        countDownWindow := GetNewWindow(BASE_RES_ID, nil, WindowPtr(-1));
        SetPort(countDownWindow);
        ShowWindow(countDownWindow);
        TextFace([bold]);
        TextSize(24);

        GetDateTime(myTime);
        oldTime := myTime;

        if gSeconds_or_minutes = minutes then
            numSecs := numSecs * SECONDS_PER_MINUTE;

        gCounting := TRUE;

        while (numSecs > 0) and gCounting do
            begin
                HandleEvent;
                if gCounting then
                    begin
                        MoveTo(LEFT, TOP);
                        GetDateTime(myTime);
                        if myTime <> oldTime then
                            begin
                                difTime := myTime - oldTime;
                                numSecs := numSecs - difTime;
                                oldTime := myTime;
                                NumToString(numSecs, myTimeString);
                                EraseRect(countDownWindow^.portRect);
                                DrawString(myTimeString);
                            end;
                    end;
            end;

        if gCounting then
            SetNotification;

        gCounting := FALSE;
        HideWindow(countDownWindow);
    end;


{-------------------------------->    RestoreSettings    <---}

    procedure RestoreSettings;
        var
            itemType: INTEGER;
            itemRect: Rect;
            itemHandle: Handle;
    begin
        GetDItem(gSettingsDialog, TIME_FIELD, itemType, itemHandle, itemRect);
        SetIText(itemHandle, savedSettings.timeString);
        GetDItem(gSettingsDialog, SOUND_ON_BOX, itemType, itemHandle, itemRect);
        SetCtlValue(ControlHandle(itemHandle), savedSettings.sound);
        GetDItem(gSettingsDialog, ICON_ON_BOX, itemType, itemHandle, itemRect);
        SetCtlValue(ControlHandle(itemHandle), savedSettings.icon);
        GetDItem(gSettingsDialog, ALERT_ON_BOX, itemType, itemHandle, itemRect);
        SetCtlValue(ControlHandle(itemHandle), savedSettings.alert);
        GetDItem(gSettingsDialog, SECS_RADIO, itemType, itemHandle, itemRect);
        SetCtlValue(ControlHandle(itemHandle), savedSettings.secsRadio);
        GetDItem(gSettingsDialog, MINS_RADIO, itemType, itemHandle, itemRect);
        SetCtlValue(ControlHandle(itemHandle), savedSettings.minsRadio);

        if savedSettings.secsRadio = ON then
            begin
                GetDItem(gSettingsDialog, S_OR_M_FIELD, itemType, itemHandle, itemRect);
                SetIText(itemHandle, 'seconds');
            end
        else
            begin
                GetDItem(gSettingsDialog, S_OR_M_FIELD, itemType, itemHandle, itemRect);
                SetIText(itemHandle, 'minutes');
            end;
    end;


{-------------------------------->    SaveSettings    <---}

    procedure SaveSettings;
        var
            itemType: INTEGER;
            itemRect: Rect;
            itemHandle: Handle;
    begin
        GetDItem(gSettingsDialog, TIME_FIELD, itemType, itemHandle, itemRect);
        GetIText(itemHandle, savedSettings.timeString);
        GetDItem(gSettingsDialog, SOUND_ON_BOX, itemType, itemHandle, itemRect);
        savedSettings.sound := GetCtlValue(ControlHandle(itemHandle));
        GetDItem(gSettingsDialog, ICON_ON_BOX, itemType, itemHandle, itemRect);
        savedSettings.icon := GetCtlValue(ControlHandle(itemHandle));
        GetDItem(gSettingsDialog, ALERT_ON_BOX, itemType, itemHandle, itemRect);
        savedSettings.alert := GetCtlValue(ControlHandle(itemHandle));
        GetDItem(gSettingsDialog, SECS_RADIO, itemType, itemHandle, itemRect);
        savedSettings.secsRadio := GetCtlValue(ControlHandle(itemHandle));
        GetDItem(gSettingsDialog, MINS_RADIO, itemType, itemHandle, itemRect);
        savedSettings.minsRadio := GetCtlValue(ControlHandle(itemHandle));
    end;


{-------------------------------->    HandleDialog    <---}

    procedure HandleDialog;
        var
            dialogDone: BOOLEAN;
            itemHit, itemType: INTEGER;
            alarmDelay: LONGINT;
            delayString: Str255;
            itemRect: Rect;
            itemHandle: Handle;
    begin
        ShowWindow(gSettingsDialog);
        SaveSettings;

        dialogDone := FALSE;
        while dialogDone = FALSE do
            begin
                ModalDialog(nil, itemHit);
                case itemHit of
                    SAVE_BUTTON:
                        begin
                            HideWindow(gSettingsDialog);
                            dialogDone := TRUE;
                        end;
                    CANCEL_BUTTON:
                        begin
                            HideWindow(gSettingsDialog);
                            RestoreSettings;
                            dialogDone := TRUE;
                        end;
                    SOUND_ON_BOX:
                        begin
                            GetDItem(gSettingsDialog, SOUND_ON_BOX, itemType, itemHandle, itemRect);
                            if GetCtlValue(ControlHandle(itemHandle)) = ON then
                                SetCtlValue(ControlHandle(itemHandle), OFF)
                            else
                                SetCtlValue(ControlHandle(itemHandle), ON);
                        end;
                    ICON_ON_BOX:
                        begin
                            GetDItem(gSettingsDialog, ICON_ON_BOX, itemType, itemHandle, itemRect);
                            if GetCtlValue(ControlHandle(itemHandle)) = ON then
                                SetCtlValue(ControlHandle(itemHandle), OFF)
                            else
                                SetCtlValue(ControlHandle(itemHandle), ON);
                        end;
                    ALERT_ON_BOX:
                        begin
                            GetDItem(gSettingsDialog, ALERT_ON_BOX, itemType, itemHandle, itemRect);
                            if GetCtlValue(ControlHandle(itemHandle)) = ON then
                                SetCtlValue(ControlHandle(itemHandle), OFF)
                            else
                                SetCtlValue(ControlHandle(itemHandle), ON);
                        end;
                    SECS_RADIO:
                        begin
                            gSeconds_or_minutes := seconds;
                            GetDItem(gSettingsDialog, MINS_RADIO, itemType, itemHandle, itemRect);
                            SetCtlValue(ControlHandle(itemHandle), OFF);
                            GetDItem(gSettingsDialog, SECS_RADIO, itemType, itemHandle, itemRect);
                            SetCtlValue(ControlHandle(itemHandle), ON);
                            GetDItem(gSettingsDialog, S_OR_M_FIELD, itemType, itemHandle, itemRect);
                            SetIText(itemHandle, 'seconds');
                            GetDItem(gSettingsDialog, TIME_FIELD, itemType, itemHandle, itemRect);
                            SetIText(itemHandle, gDefaultSecsH^^);
                        end;
                    MINS_RADIO:
                        begin
                            gSeconds_or_minutes := minutes;
                            GetDItem(gSettingsDialog, SECS_RADIO, itemType, itemHandle, itemRect);
                            SetCtlValue(ControlHandle(itemHandle), OFF);
                            GetDItem(gSettingsDialog, MINS_RADIO, itemType, itemHandle, itemRect);
                            SetCtlValue(ControlHandle(itemHandle), ON);
                            GetDItem(gSettingsDialog, S_OR_M_FIELD, itemType, itemHandle, itemRect);
                            SetIText(itemHandle, 'minutes');
                            GetDItem(gSettingsDialog, TIME_FIELD, itemType, itemHandle, itemRect);
                            SetIText(itemHandle, gDefaultMinsH^^);
                        end;
                end;
            end;
    end;


{-------------------------------->    HandleFileChoice    <---}

    procedure HandleFileChoice (theItem: INTEGER);
        var
            timeString: Str255;
            countDownTime: LONGINT;
            itemType: INTEGER;
            itemRect: Rect;
            itemHandle: Handle;
            dummy: OSErr;
    begin
        case theItem of
            CHANGE_ITEM:
                HandleDialog;
            START_STOP_ITEM:
                if gCounting then
                    begin
                        SetItem(gFileMenu, theItem, 'Start Countdown');
                        gCounting := FALSE;
                    end
                else
                    begin
                        HiliteMenu(0);
                        GetDItem(gSettingsDialog, TIME_FIELD, itemType, itemHandle, itemRect);
                        GetIText(itemHandle, timeString);
                        StringToNum(timeString, countDownTime);

                        DisableItem(gFileMenu, CHANGE_ITEM);
                        SetItem(gFileMenu, theItem, 'Stop Countdown');
                        CountDown(countDownTime);
                        EnableItem(gFileMenu, CHANGE_ITEM);
                        SetItem(gFileMenu, theItem, 'Start Countdown');
                    end;
            KILL_ITEM:
                begin
                    dummy := NMRemove(@gMyNMRec);
                    HUnlock(Handle(gNotifyStrH));
                    DisableItem(gFileMenu, KILL_ITEM);
                    gNotify_set := FALSE;
                end;
            QUIT_ITEM:
                begin
                    gCounting := FALSE;
                    gDone := TRUE;
                    if gNotify_set then
                        dummy := NMRemove(@gMyNMRec);
                end;
        end;
    end;


{-------------------------------->    HandleAppleChoice    <---}

    procedure HandleAppleChoice (theItem: INTEGER);
        var
            accName: Str255;
            accNumber, itemNumber, dummy: INTEGER;
    begin
        case theItem of
            ABOUT_ITEM:
                dummy := NoteAlert(ABOUT_ALERT, nil);
            otherwise
                begin
                    GetItem(gAppleMenu, theItem, accName);
                    accNumber := OpenDeskAcc(accName);
                end;
        end;
    end;


{-------------------------------->    HandleMenuChoice    <---}

    procedure HandleMenuChoice (menuChoice: LONGINT);
        var
            theMenu, theItem: INTEGER;
    begin
        if menuChoice <> 0 then
            begin
                theMenu := HiWord(menuChoice);
                theItem := LoWord(menuChoice);

                case theMenu of
                    APPLE_MENU_ID:
                        HandleAppleChoice(theItem);
                    FILE_MENU_ID:
                        HandleFileChoice(theItem);
                end;

                HiliteMenu(0);
            end;
    end;


{-------------------------------->    HandleMouseDown    <---}

    procedure HandleMouseDown;
        var
            whichWindow: WindowPtr;
            thePart: INTEGER;
            menuChoice, windSize: LONGINT;
    begin
        thePart := FindWindow(gTheEvent.where, whichWindow);
        case thePart of
            inMenuBar:
                begin
                    menuChoice := MenuSelect(gTheEvent.where);
                    HandleMenuChoice(menuChoice);
                end;
            inSysWindow:
                SystemClick(gTheEvent, whichWindow);
            inDrag:
                DragWindow(whichWindow, gTheEvent.where, gDragRect);
            inGoAway:
                gDone := TRUE;
        end;
    end;


{-------------------------------->    HandleEvent    <---}

    procedure HandleEvent;
        var
            theChar: CHAR;
            dummy: BOOLEAN;
    begin
        dummy := WaitNextEvent(everyEvent, gTheEvent, MIN_SLEEP, nil);

        case gTheEvent.what of
            mouseDown:
                HandleMouseDown;
            keyDown, autoKey:
                begin
                    theChar := CHR(BitAnd(gTheEvent.message, charCodeMask));
                    if (BitAnd(gTheEvent.modifiers, cmdKey) <> 0) then
                        HandleMenuChoice(MenuKey(theChar));
                end;
        end;
    end;


{-------------------------------->    MainLoop    <---}

    procedure MainLoop;
    begin
        gDone := FALSE;
        gCounting := FALSE;
        gNotify_set := FALSE;

        while gDone = FALSE do
            HandleEvent;
    end;


{-------------------------------->    NotifyInit    <---}

    procedure NotifyInit;
    begin
        gNotifyStrH := GetString(BASE_RES_ID);
        gMyNMRec.qType := nmType;
        gMyNMRec.nmMark := MARK_APPLICATION;
        gMyNMRec.nmResp := nil;
    end;


{-------------------------------->    SetUpDragRect    <---}

    procedure SetUpDragRect;
    begin
        gDragRect := screenBits.bounds;
        gDragRect.left := gDragRect.left + DRAG_THRESHOLD;
        gDragRect.right := gDragRect.right - DRAG_THRESHOLD;
        gDragRect.bottom := gDragRect.bottom - DRAG_THRESHOLD;
    end;


{-------------------------------->    MenuBarInit    <---}

    procedure MenuBarInit;
        var
            myMenuBar: Handle;
    begin
        myMenuBar := GetNewMBar(BASE_RES_ID);
        SetMenuBar(myMenuBar);
        gAppleMenu := GetMHandle(APPLE_MENU_ID);
        AddResMenu(gAppleMenu, 'DRVR');
        gFileMenu := GetMHandle(FILE_MENU_ID);
        DrawMenuBar;
    end;


{-------------------------------->    DialogInit    <---}

    procedure DialogInit;
        var
            itemType: INTEGER;
            itemRect: Rect;
            itemHandle: Handle;
    begin
        gDefaultSecsH := GetString(DEFAULT_SECS_ID);
        gDefaultMinsH := GetString(DEFAULT_MINS_ID);

        gSettingsDialog := GetNewDialog(BASE_RES_ID, nil, WindowPtr(-1));
        GetDItem(gSettingsDialog, SECS_RADIO, itemType, itemHandle, itemRect);
        SetCtlValue(ControlHandle(itemHandle), ON);
        GetDItem(gSettingsDialog, SOUND_ON_BOX, itemType, itemHandle, itemRect);
        SetCtlValue(ControlHandle(itemHandle), ON);
        GetDItem(gSettingsDialog, ICON_ON_BOX, itemType, itemHandle, itemRect);
        SetCtlValue(ControlHandle(itemHandle), ON);
        GetDItem(gSettingsDialog, ALERT_ON_BOX, itemType, itemHandle, itemRect);
        SetCtlValue(ControlHandle(itemHandle), ON);

        gSeconds_or_minutes := seconds;
    end;


{-------------------------------->    Sys6OrLater    <---}

    function Sys6OrLater: BOOLEAN;
        var
            status: OSErr;
            SysEnvData: SysEnvRec;
            dummy: INTEGER;
    begin
        status := SysEnvirons(SYS_VERSION, SysEnvData);
        if (status <> noErr) or (SysEnvData.systemVersion < $0600) then
            begin
                dummy := StopAlert(BAD_SYS_ALERT, nil);
                Sys6OrLater := FALSE;
            end
        else
            Sys6OrLater := TRUE;
    end;


{-------------------------------->    Reminder    <---}

begin
    if Sys6OrLater then
        begin
            DialogInit;
            MenuBarInit;
            SetUpDragRect;
            NotifyInit;

            MainLoop;
        end;
end.